home *** CD-ROM | disk | FTP | other *** search
/ Super Games for Windows 3 / Super Games for Windows 3.iso / mcheat / mcheat.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-12-28  |  6.4 KB  |  176 lines
  1. PROGRAM MineCheat;
  2. {$d Mine cheat By Keith Garner 1992}
  3. {$R mcheat}
  4. Uses WinTypes, WinProcs, WObjects, strings;
  5.  
  6. CONST AppName : PChar = 'MCHEAT'; { the application name }
  7.       CoverMsg: Pchar = 'Please close or move the window'^M'covering'+
  8.                         ' the top left corner!'^M'( Before you continue ! )';
  9.       ErrorMsg: Pchar = 'MineCheat Error!';
  10.       id_cheat = 101; { the resource number of the CHEAT button }
  11.       black = 0;
  12.       white = $ffffff;
  13.       xOff = 4; { width of left border in Minesweeper window client area - 16}
  14.       yOff = 47; { width of top  border in Minesweeper window client area - 16}
  15.  
  16. TYPE
  17.   TMyApplication = OBJECT(TApplication)
  18.     PROCEDURE InitMainWindow; virtual;
  19.   END;
  20.  
  21.   PCheat = ^TCheat;
  22.   TCheat = OBJECT(TDlgWindow)
  23.     MsWin: HWnd;
  24.     rpr: TRect;
  25.     PROCEDURE SendSecretMsg;
  26.     PROCEDURE SetUpWindow; Virtual;
  27.     FUNCTION  GetClassName : PChar; Virtual;
  28.     PROCEDURE WMDestroy (VAR msg: TMessage); VIRTUAL wm_first + wm_Destroy;
  29.     PROCEDURE Cheat_Now (VAR msg: TMessage); VIRTUAL id_first + id_cheat;
  30.   END;
  31.  
  32. {--------------------------------------------------}
  33. { Support Procedures                               }
  34. {--------------------------------------------------}
  35.   procedure WaitIdle; {It's impolite to hog the CPU}
  36.   var m: TMsg;
  37.   begin
  38.      while PeekMessage(m, 0, 0, 0, pm_Remove) do begin
  39.         if m.message = wm_Quit then HALT(m.wParam);
  40.         TranslateMessage(m);
  41.         DispatchMessage(m);
  42.      end;
  43.   end;
  44.  
  45.   function MyGetPixel(TheWin:HWnd;x,y:Integer;Compare:LongInt):Boolean;
  46.   var msDC: HDC;
  47.   begin
  48.      msDC := GetDC(TheWin);
  49.      MyGetPixel := compare = GetPixel(msDC,x,y); { get a pixel & compare }
  50.      ReleaseDC(TheWin, msDC);
  51.   end;
  52.  
  53. {--------------------------------------------------}
  54. { TCheat's methods                                 }
  55. {--------------------------------------------------}
  56.   PROCEDURE TCheat.Cheat_Now (VAR msg: TMessage);
  57.   VAR I, J: integer;
  58.       st: ARRAY[0..32] OF CHAR;
  59.       Wn: HWnd;
  60.       TmpRpr: TRect;
  61.  
  62.       procedure Click(btnDown, btnUp: WORD); { send a simulated mouse click }
  63.       begin
  64.         PostMessage(msWin, btnDown, 0, MakeLong(xOff + 16*I, yOff + 16*J));
  65.         PostMessage(msWin, btnUp, 0, MakeLong(xOff + 16*I, yOff + 16*J));
  66.       end; {Click}
  67.  
  68.   BEGIN
  69.      { Step #1 if MineSweeper is still on the screen AND it's size has changed:
  70.        Change the dimenions. }
  71.      if (msWin <> 0 ) then begin
  72.         getClientRect(Mswin,TmpRpr);
  73.         if (TmpRpr.top<>Rpr.top)or(TmpRpr.left<>Rpr.left)or
  74.            (TmpRpr.right<>Rpr.right)or(TmpRpr.bottom<>Rpr.bottom) then
  75.                getClientRect(Mswin,Rpr);
  76.      end;
  77.      { Step #2 Find MineSweeper ( if not found allready ) and then send 
  78.        the secret code ! "x y z z y <return> <shift>+<return>" }
  79.      if (MsWin = 0) or (not iswindow(MsWin)) then begin
  80.          MsWin := 0;
  81.          Wn := GetWindow(hWindow, gw_HWndFirst);
  82.          WHILE (Wn <> 0 ) and (MsWin = 0 ) DO BEGIN
  83.              Wn := GetNextWindow(Wn, gw_HWndNext);
  84.              GetWindowText(Wn, st, 32);
  85.              IF StrComp(st, 'Minesweeper') = 0 THEN BEGIN
  86.                  MsWin := Wn;
  87.                  SendSecretMsg;
  88.                  GetClientRect(MsWin, rpr); { get the MineSweeper size }
  89.              END;
  90.          END;
  91.      end;
  92.      { Step #3 Make sure that the MineSweeper window is known and that
  93.        the top left square is up ( not solved ) }
  94.      if (MSWin=0) or (not MyGetPixel(MsWin,xOff+9,yOff+16,white)) then
  95.         MessageBox(hwindow,'Minesweeper not ready!',ErrorMsg,mb_ok)
  96.      else for J := 1 to ((rpr.bottom - 67) DIV 16) do
  97.             for I := 1 to ((rpr.right - 24) DIV 16) do begin
  98.               { Step # 4 for every square :
  99.                    Move the mouse to the square.
  100.                    if the square has allready been marked, skip it.
  101.                    Read the color from the top corner of the screen.
  102.                    Mark or step on a square } 
  103.               PostMessage(MsWin, WM_MouseMove,0, MakeLong(xOff+16*I,yOff+16*J));
  104.               WaitIdle;
  105.               if (J=1) and (I=1) then
  106.                   Click(WM_LBUTTONDOWN,WM_LBUTTONUP)
  107.               else if MyGetPixel(0,0,0,black) then
  108.                   Click(WM_RBUTTONDOWN,WM_RBUTTONUP)
  109.               else if MyGetPixel(MsWin,xOff-7+16*I,yOff+0+16*J,white) then
  110.                   Click(WM_LBUTTONDOWN,WM_LBUTTONUP);
  111.            end;
  112.   END;
  113.  
  114.   PROCEDURE TCheat.WMDestroy(VAR msg: TMessage);
  115.   BEGIN
  116.     SendSecretMsg;
  117.     TDlgWindow.WMDestroy(msg);
  118.   END;
  119.  
  120.   PROCEDURE TCheat.SendSecretMsg;
  121.   BEGIN
  122.       PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('x')), $2d0001);
  123.       PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('y')), $150001);
  124.       PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('z')), $2c0001);
  125.       PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('z')), $2c0001);
  126.       PostMessage(MsWin, WM_KEYDOWN,vkKeyscan(ord('y')), $150001);
  127.       PostMessage(MsWin, WM_KEYDOWN,vk_return, $1c0001);
  128.       PostMessage(MsWin, WM_KEYDOWN,vk_shift, $360001);
  129.       PostMessage(MsWin, WM_KEYDOWN,vk_return, $1c0001);
  130.       WaitIdle;
  131.   END;
  132.  
  133.  
  134.   PROCEDURE TCheat.SetUpWindow;
  135.   var st: ARRAY[0..80] OF CHAR;
  136.       TmpWin : HWnd;
  137.       p : tpoint;
  138.   BEGIN
  139.     TDlgWindow.SetUpWindow;
  140.     SetClassWord(hWindow, GCW_HICON, LoadIcon(hInstance, AppName));
  141.     { -- make sure that no other programs cover the screen -- }
  142.     p.x := 0 ; p.y := 0;
  143.     TmpWin := WindowFromPoint(P);
  144.     GetWindowText(TmpWin, st, 80);
  145.     While (TmpWin <> 0) and (StrComp(st, '') <> 0 ) do begin
  146.        if MessageBox(HWindow,CoverMsg,ErrorMsg,mb_retrycancel+mb_iconstop)=
  147.           IDCANCEL then halt(1);
  148.        TmpWin := WindowFromPoint(P);
  149.        GetWindowText(TmpWin, st, 80);
  150.     end;
  151.     MsWin := 0;
  152.   END;
  153.  
  154.   FUNCTION TCheat.GetClassName;
  155.   BEGIN
  156.     GetClassName := AppName;
  157.   END;
  158.  
  159. {--------------------------------------------------}
  160. { TMyApplication's method implementations:         }
  161. {--------------------------------------------------}
  162.   PROCEDURE TMyApplication.InitMainWindow;
  163.   BEGIN
  164.     MainWindow := New(PCheat, Init(NIL, AppName));
  165.   END;
  166.  
  167. {--------------------------------------------------}
  168. { Main program:                                    }
  169. {--------------------------------------------------}
  170. VAR MyApp: TMyApplication;
  171. BEGIN
  172.   MyApp.Init(AppName);
  173.   MyApp.Run;
  174.   MyApp.Done;
  175. END.
  176.